home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / general / ibs grabber.amos / ibs grabber.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-06-13  |  4.0 KB  |  189 lines
  1. ' ------------------------   
  2. ' |   IBS Grabber v1.0   |   
  3. ' |                      | 
  4. ' |   (c) W.H.Liu 1991   |   
  5. ' ------------------------ 
  6. '
  7. Global VPOS,CUTVAR,IMAGENO
  8. VPOS=50
  9. CUTVAR=0
  10. IMAGENO=1
  11. SETUPSCREENS
  12. DISPLAYNO
  13. SETUPZONES
  14. Do 
  15.    Screen 1
  16.    SETUPZONES
  17.    If(Mouse Click=1 and Mouse Zone<>0)
  18.       On Mouse Zone Proc SUBTRACT,PLUS,CUTBOB,PICLOAD,ABKLOAD,ABKLOAD,ABKSAVE,ICONSAVE,QUITIBS
  19.    End If 
  20.    Screen 0
  21.    CHECKKEYS
  22.    If(CUTVAR=0 and Scin(X Mouse,Y Mouse)=0) Then DISPLAYBOB
  23.    If(CUTVAR=1 and Scin(X Mouse,Y Mouse)=0 and Mouse Key=1) Then CUTBOB
  24. Loop 
  25. Procedure SETUPSCREENS
  26.    Colour 1,0
  27.    Double Buffer 
  28.    Curs Off 
  29.    Flash Off 
  30.    Unpack 10 To 1
  31. End Proc
  32. Procedure SETUPZONES
  33.    Reserve Zone 9
  34.    ZY1=13
  35.    ZY2=21
  36.    Set Zone 1,11,ZY1 To 17,ZY2
  37.    Set Zone 2,50,ZY1 To 56,ZY2
  38.    Set Zone 3,69,ZY1 To 85,ZY2
  39.    Set Zone 4,98,ZY1 To 126,ZY2
  40.    Set Zone 5,139,ZY1 To 171,ZY2
  41.    Set Zone 6,184,ZY1 To 215,ZY2
  42.    Set Zone 7,228,ZY1 To 260,ZY2
  43.    Set Zone 8,273,ZY1 To 309,ZY2
  44.    Set Zone 9,0,0 To 319,8
  45. End Proc
  46. Procedure CHECKKEYS
  47.    A$=Inkey$
  48.    A=Scancode
  49.    If A=69 Then Erase 1 : Erase 2 : IMAGENO=1 : DISPLAYNO
  50.    If A=76 Then GOUP
  51.    If A=77 Then GODOWN
  52.    A=0
  53. End Proc
  54. Procedure GODOWN
  55.    Add VPOS,5
  56.    If VPOS>Screen Height+25 Then VPOS=Screen Height+25
  57.    DISPLAYSCREEN
  58. End Proc
  59. Procedure GOUP
  60.    Add VPOS,-5
  61.    If VPOS<35 Then VPOS=35
  62.    DISPLAYSCREEN
  63. End Proc
  64. Procedure DISPLAYSCREEN
  65.    Screen Display 1,,VPOS,,
  66. End Proc
  67. Procedure DISPLAYBOB
  68.    If IMAGENO<=Length(1)
  69.       If Length(1)>0
  70.          Hide 
  71.          While Scin(X Mouse,Y Mouse)=0
  72.             Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),IMAGENO
  73.             CHECKKEYS
  74.          Wend 
  75.          Bob Off 
  76.          Show 
  77.       End If 
  78.    End If 
  79. End Proc
  80. Procedure SUBTRACT
  81.    Dec IMAGENO
  82.    If IMAGENO=0 Then IMAGENO=1 : Pop Proc
  83.    DISPLAYNO
  84. End Proc
  85. Procedure DISPLAYNO
  86.    Screen 1
  87.    Ink 2
  88.    Bar 22,13 To 45,21
  89.    Ink 0
  90.    Gr Writing 0
  91.    Text 22,20,Right$("00"+Mid$(Str$(IMAGENO),2),3)
  92.    Screen 0
  93. End Proc
  94. Procedure PLUS
  95.    Inc IMAGENO
  96.    If IMAGENO=1000 Then IMAGENO=999 : Pop Proc
  97.    If IMAGENO-Length(1)=2 Then Dec IMAGENO : Pop Proc
  98.    DISPLAYNO
  99. End Proc
  100. Procedure CUTON
  101.    CUTVAR=1
  102. End Proc
  103. Procedure CUTBOB
  104.    Screen Hide 1
  105.    Screen 0
  106.    While Mouse Click<>1
  107.       X1=X Screen(X Mouse)
  108.       Y1=Y Screen(Y Mouse)
  109.    Wend 
  110.    If X1>Screen Width Then X1=Screen Width-1
  111.    If Y1>Screen Height Then Y1=Screen Height-1
  112.    If Y1<0 Then Y1=0
  113.    Do 
  114.       X2=X Screen(X Mouse)
  115.       Y2=Y Screen(Y Mouse)
  116.       If X2>Screen Width Then X2=Screen Width-1
  117.       If Y2>Screen Height Then Y2=Screen Height-1
  118.       Gr Writing 3
  119.       Ink 1
  120.       Box X1,Y1 To X2,Y2
  121.       Box X1,Y1 To X2,Y2
  122.       Exit If Mouse Key<>1
  123.    Loop 
  124.    If(X2>X1 and Y2>Y1)
  125.       Get Bob 0,IMAGENO,X1,Y1 To X2,Y2
  126.       Screen 1
  127.       Screen Show 1
  128.       PLUS
  129.    Else 
  130.       Screen Show 1
  131.    End If 
  132. End Proc
  133. Procedure PICLOAD
  134.    FILE$=Fsel$("","","Load an IFF picture")
  135.    If FILE$="" Then Pop Proc
  136.    If Exist(FILE$) Then Load Iff FILE$,0
  137.    Double Buffer 
  138.    Screen To Front 1
  139. End Proc
  140. Procedure ABKLOAD
  141.    If Mouse Zone=5
  142.       FILE$=Fsel$("*.ABK","","Load a Sprite bank")
  143.       CLEARVAR=1
  144.    Else 
  145.       FILE$=Fsel$("*.ABK","","Append a Sprite bank")
  146.    End If 
  147.    If FILE$="" Then Pop Proc
  148.    Open In 1,FILE$
  149.    If Input$(1,4)="AmSp"
  150.       If CLEARVAR=1
  151.          Erase 1
  152.          IMAGENO=1
  153.          CLEARVAR=0
  154.       End If 
  155.       Load FILE$,1
  156.       Screen 0
  157.       Get Sprite Palette 
  158.       Screen 1
  159.       DISPLAYNO
  160.    End If 
  161.    Close 1
  162. End Proc
  163. Procedure ABKSAVE
  164.    FILE$=Fsel$("*.ABK","","Save a Sprite bank")
  165.    If FILE$="" Then Pop Proc
  166.    Save FILE$,1
  167. End Proc
  168. Procedure ICONSAVE
  169.    FILE$=Fsel$("*.ABK","","Save an Icon bank")
  170.    If FILE$="" Then Pop Proc
  171.    GFXTOICONS
  172.    Save FILE$,2
  173. End Proc
  174. Procedure GFXTOICONS
  175.    For I=1 To Length(1)
  176.       BASE=Sprite Base(I)
  177.       Screen Open 2,Deek(BASE)*16,Deek(BASE+2),2^Deek(BASE+4),Lowres
  178.       Screen To Back 2
  179.       Curs Off : Flash Off 
  180.       Get Sprite Palette 
  181.       Paste Bob 0,0,I
  182.       Get Icon I,0,0 To Deek(BASE)*16,Deek(BASE+2)
  183.    Next I
  184.    Screen Close 2
  185. End Proc
  186. Procedure QUITIBS
  187.    Screen Close 1
  188.    End 
  189. End Proc